perm filename METER.F4[P11,LCS] blob sn#570610 filedate 1981-03-08 generic text, type T, neo UTF8
00100		SUBROUTINE METER
00200	      COMMON R2,JA,CENTR,J2,RJQ(20),JQ(17),T,Z,H/STF/RSTFAC(8),RSTJ2
00300	     1 /POSI/STFF(0/7),JJ2,POS
00400	      EQUIVALENCE (R4,RJQ(2)),(J4,JQ(2)),(J5,JQ(3)),(J6,JQ(4))
00500	     1,(R6,RJQ(4)),(R5,RJQ(3)),(R3,RJQ(1)),(R7,RJQ(5)),
00600	     1 (R8,RJQ(6)),(R10,RJQ(8)),(R11,RJQ(9)),(R9,RJQ(7))
00700	     1,(RX3,RJQ(20)),(J3,JQ(1))
00800		IF(R7.NE.0)GO TO 10
00900		R7=1.25
01000		GO TO 11
01100	10	R7=R7*1.25
01200	11	R4=R4-2.21
01300		KS=0
01400	C  FLAG FOR DOUBLE METERS 3/4+5/8 ETC.
01500		IF(R8.EQ.0)GO TO 1
01600		RD8=R8
01700	C SAVE VARIOUS PARAMETERS
01800		R8=0
01900		RD7=R7
02000	C  SIZE
02100		RD3=R3
02200		CENTD=CENTR
02300		KS=-1
02400	C  SET DOUBLE METER FLAG
02500		RD4=R4
02600		POSP=12.
02700	C POS FOR PLUS SIGN
02800		POSM=19.
02900	C POS FOR 2ND METER
03000		IF(J6.LT.10)GO TO 6
03100	C  INCREASE SPACE FOR DOUBLE DIGIT NUMBERS
03200		POSP=17.
03300		POSM=24.
03400	6	IF(R10.EQ.0)R10=1
03500		IF(R11.EQ.0)R11=R10 
03600	C R10 MOVES +, R11 MOVES 2ND METER
03700		POSP=POSP*R10
03800	C P10, P11 CAN CHANGE SPREAD BETWEEN METERS
03900		POSM=POSM*R11
04000		R11=0
04100	C R11 MUST =0 FOR OTHER PLACES
04200	1	 JZ=J3
04300		IF(R5.NE.0)GO TO 102
04400	C     	MOVEM 	02,JZ#   ;	25300	      RY=R4+8.*.COMM.+=8
04500		R7=R7+.25
04600	C INCREASE SIZE(1.25) FOR SINGLE METER.
04700		R4=R4+.94
04800	102	R4=R4+R7*8.
04900	C  ADD 8 TO RAISE IT
05000		RY=R4
05100	C  HEIGHT
05200		RW=R6
05300	C  BOTTOM NUM
05400		R6=R7
05500		RR6=R6
05600	C  SIZE     FOR BDR40  -- OR =1
05700		M=0
05800	2	R7=0
05900		IF(R5.EQ.0)GO TO 103
06000		IF(R5.LT.90.)GO TO 3
06100		M=-1
06200	C IF TOP NUM.=0 SKIP OVER
06300	C   99 AS METER = 'C'  98=ALLA BREVE (CUT TIME)
06400	      IF(R5.NE.98)GO TO 4
06500	C  NEXT FOR LINE THROUGH C.
06600		    RA=POS
06700		R6=RX3
06800	C  TO LINE UP WITH R3
06900		J10=2
07000	C FOR THICK LINE
07100		     R4=R4-3.8
07200		    R5=R4+5.6
07300		J7=0
07400		R8=0
07500		CALL ITMSUB
07600		POS=RA
07700		R4=RY
07800		R6=RR6
07900	C GET BACK THE RIGHT PARAMS.
08000	4	R5=9999.
08100	C  TO CENTER 12S AND 16S
08200	3     CALL MAKNUM(R5)
08300		IF(M.LT.0)GO TO 5
08400	103	M=-1
08500	C  STICK AROUND FOR BOTTOM NUM
08600		R6=RR6
08700		R4=RY+.9-4.*RR6
08800		R5=RW
08900	C  GET BOTTOM NUM
09000		J3=JZ
09100		R8=0
09200		IF(R5.GT.0)GO TO 2
09300	5	IF(KS.EQ.0)RETURN
09400	C SKIP IF DOUBLE METER
09500		KS=0
09600		R4=RD4+4.
09700	C GET BACK VERT POS.
09800	C ADD FOR + SIGN
09900		RX=R9
10000		R6=RD7
10100	C SIZE
10200		R7=RD7
10300		R9=0
10400		R8=0
10500		JA=9
10600		J5=14
10700		RJ=RSTJ2*RD7
10800		CENTR=CENTD+36.*RJ
10900		JZ=JZ+POSM*RJ
11000		J3=JZ
11100		R3=RD3+POSP*RJ
11200	C MOVE TO RIGHT 25 BASIC NOTCHES
11300	C SHIFT + 10 NOTCHES TO RIGHT OF ORIG.
11400		CALL NOTWRT
11500		R4=RD4
11600	C GET BACK BASIC R4
11700	C PUT RD8 AND RX INTO R5 AND R6
11800		R5=RD8
11900		R6=RX
12000		R7=RD7
12100	C GET BACK SIZE
12200		X=20.
12300	C SHIFT MORE TO RIGHT
12400	C ADD MORE SPACE IF BOT. # >10
12500		IF(RX.GE.10.)X=25.
12600		JZ=JZ+X*RJ
12700		J3=JZ
12800	C NEW POS IN J3
12900		GO TO 1
13000		END